######################################################################
# Copyright (c) 2009-2015, Intel Corporation
# All rights reserved.
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
#   * Redistributions of source code must retain the above copyright notice, 
#     this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above copyright notice, 
#     this list of conditions and the following disclaimer in the documentation 
#     and/or other materials provided with the distribution.
#   * Neither the name of Intel Corporation nor the names of its contributors 
#     may be used to endorse or promote products derived from this software 
#     without specific prior written permission.

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.
######################################################################


######################################################################
# Create Basic .c and .h Files from PerlDB 
#  NOTE - creates a single file to cover all boxes, therefore each record
#    includes all possible fields even though certain fields (e.g. portmask
#    in IIO) are only valid for certain events/subevents in certain boxes 
######################################################################

#  Establishing base version - use '-v' to change
$PerlDBEvents  = "../../UncoreRM/v0.10/skx_uc_events.v0.10p.pl";
$PerlDBDerived = "../../UncoreRM/v0.10/skx_uc_derived.v0.10p.pl";

# Resetting for SKX 

my %BoxInitials = 
(
   "CHA"    => "C",  
   "iMC"    => "M",  
   "UPI LL" => "UP",  
   "M2PCIe" => "MP",  
   "M2M"    => "M2",  
   "M3UPI"  => "M3",  
   "PCU"    => "P",  
   "UBOX"   => "U",  
   "IRP"    => "IR",  
   "IIO"    => "IO",  
);

$MAX_REGS       =   8;
$MAX_NAMELEN    =  64;
$MAX_DESCLEN    = 128;
$MAX_DEPSLEN    = 128;
$CHIP           = "SKX";

&main;



#######################################################################
#  Some Helper Functions - 
#    Few used by this script, but good for changing event ordering
#######################################################################
#######################################################################
#   Some sorting functions for Arrays
#######################################################################
sub by_code
{
   my $acode = hex($a->{EvSel});
   my $bcode = hex($b->{EvSel});
   $acode <=> $bcode;
}

sub by_internal { $a->{internal} <=> $b->{internal}; }
sub by_name { $a->{name} cmp $b->{name}; }
sub by_box { $a->{box} cmp $b->{box}; }
sub by_cat { $a->{category} cmp $b->{category}; }


#######################################################################
#   Some sorting functions for Hashes (by value rather than name)
#######################################################################
sub by_evsel
{
   my (%hash) = @_;
   return hex($hash{$a}->{EvSel}) <=> hex($hash{$b}->{EvSel});
}
sub by_internal
{
   my (%hash) = @_;
   return hex($hash{$a}->{Internal}) <=> hex($hash{$b}->{Internal});
}

sub by_umask
{
   my (%hash) = @_;
   my $umask_a = $hash{$a}->{Umask};  $umask_a =~ s/x/0/g;  $umask_a =~ s/b//;
   my $umask_b = $hash{$b}->{Umask};  $umask_b =~ s/x/0/g;  $umask_b =~ s/b//;
   my $val_a   = &bin2dec($umask_a);  my $val_b = &bin2dec($umask_b);

   print "$a $umask_a - $val_a  vs. $b $umask_b - $val_b\n"
     if ($UMASK_SORT_DBG);
   return $val_a <=> $val_b; 

}

sub bin2dec 
{
   return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}


######################################################################
# Turn Counter Range into list of Counters 
# NOTE: assumes no more than MAX_REGS registers events can be captured in
######################################################################
sub ctr_range_to_mask
{
   my ($event) = @_;
   my ($lo,$hi,$reg_mask,$bit) = (0,0,0,0x1);
   if ($event->{Counters} =~ /(\d+)(\s*-\s*)?(\d+)?/)
   {
      ($lo,$hi) = (defined $3) ? ($1,$3) : ($1,$1);  
      for (my $i = $lo; $i <= $hi; $i++) { $reg_mask |= ($bit << $i); } 
   }
   return $reg_mask;
}




######################################################################
######################################################################
sub scrub_str
{
   my ($str) = @_;
   chomp $str;
   $str =~ s/"/\\"/g; $str =~ s/\n/\\n/g;
   return $str;
}




######################################################################
######################################################################
sub h_hdr
{
   my $chip_str  = "_" . $CHIP . "_UC_PMON_EVENT_H";
   my $chip_str2 = $CHIP . "_uc_event_entry_t";


return <<EOH;

#ifndef $chipstr
#define $chipstr

typedef struct {
    unsigned long  evsel;      // Value to write to bits  7:0 of control reg
    unsigned long  xtra_evsel; // Value to write to bit  21 of control reg
    unsigned long  umask;      // Value to write to bits 15:8 of control reg
    unsigned long  umask_ext_upi; // Value to write to bits 39:32 of control reg - for some UPI subevents
    unsigned long  fcmask_iio;    // Value to write to bits 46:44 of control reg - for some IIO subevents
    unsigned long  portmask_iio;  // Value to write to bits 43:36 of control reg - for some IIO subevents
    char[$MAX_NAMELEN]      evname;     // Event Name 
    char[$MAX_NAMELEN]      evcat;      // Event Category 
    unsigned long  ctrmask;    // Control regs event can be measure on
    unsigned long  maxinccyc;  // Max event increment per cycle 
    char[$MAX_DEPSLEN]      deps;       // Register + bit positions Event is
                               //  dependent on.
    char[$MAX_DESCLEN]      desc;       // Event Description 
    char[]         defn;       // ptr to Event Definition
} $chip_str2;

 

EOH
}

######################################################################
######################################################################
sub h_tail
{
   return "\n\n#endif\n\n";
}


######################################################################
#  Print Shared .h File
######################################################################
sub print_shared_h
{
   my ($evlist_ref) = @_;
   my $h_fname = sprintf "%s_uc_pmon_events.h", $CHIP;

   open(CHIPH, "> $h_fname") || die "Couldn't open $h_fname for Writing\n";
   print CHIPH &h_hdr();

   foreach my $boxevents (sort keys %{ $evlist_ref })
   {
      my $box = $boxevents; $box =~ s/\s+Box Events\s*//; 
      my $box_char = $BoxInitials{$box};

      my $chip_str2 = $CHIP . "_uc_event_entry_t";
      my $chip_str3 = $CHIP . "_" . $box_char . "_uc_events[]";
      printf CHIPH "extern %s %s; /* %s %s Event Tables */\n", $chip_str2, $chip_str3, $CHIP, $box;
   }
   print CHIPH &h_tail();
   close(CHIPH);
}




######################################################################
#  Convert Filter dependency field which says 'this event is dependent
#   on the setting of reg[msb:lsb], where reg is a shorthand symbol name
#   for a register, msb:lsb represent the bit positions the event is 
#   dependent on.   
#
#  NOTE: This assumes there's NO Filter value.  
#
#  Also Note that, for now, the function returns a string with comma
#  separated register name/mask value pairs. Meaning it will have to be
#  decoded in C.  Likely preferable to change this to pair the reg 
#  name and mask in structs.  But then would need to deal with variability
#  of maks dependence. 
#  
######################################################################
sub conv_filter_to_deps
{
   my ($ev, $filterlist_ref,  $depmask_ref) = @_;
   my %filterlist = %{ $filterlist_ref };
   my %depmasks   = %{ $depmask_ref };
   my $depstr = "";

   # NOTE: Need to deal with Filter! 
   my @deps = split /,/, $ev->{Filter};
   foreach my $dep (@deps)
   {
      my ($reg, $hi, $lo) = ($1, $2, $3) if ($dep =~ /(\w+)\[(\d+):(\d+)\]/);
      if (!defined $filterlist{$reg})
      {
         print STDERR "WARN: $reg wasn't found in ($dep)\n";
      }
      else
      {
         my $regname = $filterlist{$reg};
         my $depmask = 0;  my $bit = 0x1;
         for ($i = $lo; $i <= $hi; $i++)
         {
            $depmask |= ($bit << $i);   
         }
         $depmasks{$regname} = $depmask;
         $depstr .= sprintf "%s = 0x%02X,", $regname, $depmask;
      }
   }

   %{ $depmask_ref } = %depmasks;   

   chop $depstr;
   return $depstr;
}



######################################################################
# Create strings to store Event definitions 
#####################################################################
sub create_defn_strs
{
   my ($events_ref, $boxname, $box, $fh)  = @_;
   my %events = %{ $events_ref };

   die "Couldn't find $box in the data structure\n" 
      if (!defined $events{$box});

   my $box_char = $BoxInitials{$boxname};
   my %box_events = %{ $events{$box} };

   foreach my $evname (sort { by_evsel(%box_events) } keys %box_events)
   {
      my $event = $box_events{$evname};
      my $defn = &scrub_str($event->{Defn});
      my $evsel_mask = ($event->{Internal} << 21) | $event->{EvSel}; 
      my $defn_ptr   = sprintf "%s_%s_UC_0x%02X_defn", $CHIP, $box_char, $evsel_mask; 

      printf $fh "char   %s[] = \"%s\";\n", $defn_ptr, $defn;
   }
}


######################################################################
# Create Records in a .h format 
#####################################################################
sub create_c_recs
{
   my ($events_ref, $filterlist_ref, $boxname, $box, $fh)  = @_;
   my %events = %{ $events_ref };

   die "Couldn't find $box in the data structure\n" 
      if (!defined $events{$box});

   my $box_char = $BoxInitials{$boxname};
   my %box_events = %{ $events{$box} };
   my $num_events = 0;

   printf $fh "%s_uc_event_entry_t %s_%s_uc_events[] = {\n\n", $CHIP, $CHIP, $box_char;
   foreach my $evname (sort keys %box_events)
   {
      my $event = $box_events{$evname};
      my $ctr_mask = &ctr_range_to_mask($event);
      my $desc = &scrub_str($event->{Desc});
      my $defn = &scrub_str($event->{Defn});
      my $cat  = $event->{Category};

      if (length $cat >= $MAX_NAMELEN)
      {
         print STDERR "WARN: Category for $evname exceeds $MAX_NAMELEN chars and has been chopped.  Increase MAX_NAMELEN variable to fix.\n";
         $cat = substr $cat, 0, ($MAX_NAMELEN-1);
      }

      if (length $evname >= $MAX_NAMELEN)
      {
         print STDERR "WARN: $evname exceeds $MAX_NAMELEN chars and has been chopped.  Increase MAX_NAMELEN variable to fix.\n";
         $evname = substr $evname, 0, ($MAX_NAMELEN-1);
      }

      if (length $desc >= $MAX_DESCLEN)
      {
         print STDERR "WARN: Description for $evname exceeds $MAX_DESCLEN chars and has been chopped.  Increase MAX_DESCLEN variable to fix.\n";
         $desc = substr $desc, 0, ($MAX_DESCLEN-1);
      }

      # Event is uniquely identified by bits necessary to select it.
      # Using this to create simple reference define value.
      # If SW wishes to extend this concept to include control reg filter
      #  bits (e.g. edge_det, threshold), they will be creating new 'Events'.  
      my $evsel_mask = ($event->{Internal} << 21) | $event->{EvSel}; 

      my $defn_ptr   = sprintf "%s_%s_UC_0x%02X_defn", $CHIP, $box_char, $evsel_mask; 

      if ((defined $event->{Subevents}) || (keys %{$event->{Subevents} })) 
      {
         foreach my $subevname (sort keys %{ $event->{Subevents} })
         {
            next if ($subevname =~ /NONE|UNDEF|ILLEGAL/);
            my $subev = $event->{Subevents}->{$subevname};

         
            # Event|subevent hierarchy is flatted 
            #  - attach event's desc to subevent's desc.  Same with names
            my $subdesc = $desc . " -- " . &scrub_str($subev->{Desc});
            my $name    =  $evname ."." . $subevname;

            # Converts bit mask for listed subevent to simple value.
            # NOTE: this ignores any other possible combinations.  
            #       If desired, they will need to be generated by replacing 
            #       'x's following umask with highest position bit
            my $umask = $subev->{Umask}; $umask =~ s/b//g;  $umask =~ s/x/0/g;
            my $umask_val = &bin2dec($umask);


            my $umask_ext_upi = $subev->{UmaskExt}; 
            $umask_ext_upi =~ s/b//g;  $umask_ext_upi =~ s/x/0/g;
            my $umask_ext_upi_val = &bin2dec($umask_ext_upi);

            my $portmask_iio = $subev->{PortMask}; 
            $portmask_iio =~ s/b//g;  $portmask_iio =~ s/x/0/g;
            my $portmask_iio_val = &bin2dec($portmask_iio);

            my $fcmask_iio = $subev->{FCMask}; 
            $fcmask_iio =~ s/b//g;  $fcmask_iio =~ s/x/0/g;
            my $fcmask_iio_val = &bin2dec($fcmask_iio);


            if (length $name >= $MAX_NAMELEN)
            {
               print STDERR "WARN: $name exceeds $MAX_NAMELEN chars and has been chopped.  Increase MAX_NAMELEN variable to fix.\n";
               $name = substr $name, 0, ($MAX_NAMELEN-1);
            }

            if (length $subdesc >= $MAX_DESCLEN)
            {
               print STDERR "WARN: Description for $name exceeds $MAX_DESCLEN chars and has been chopped.  Increase MAX_DESCLEN variable to fix.\n";
               $subdesc = substr $subdesc, 0, ($MAX_DESCLEN-1);
            }

            my %depmasks = (); 
            my $depstr = &conv_filter_to_deps($subev, $filterlist_ref, \%depmasks);

            if (length $depstr >= $MAX_DEPSLEN)
            {
               print STDERR "WARN: String of dependencies for $name exceeds $MAX_DEPSLEN chars and has been chopped.  Increase MAX_DEPSLEN variable to fix.\n";
               $depstr = substr $depstr, 0, ($MAX_DEPSLEN-1);
            }

            my $subname = $subevname;  $subname =~ s/\./_/g; 
            printf $fh "#define %s_UC_%s_%s_%s  %d\n", $CHIP, $box_char, $evname, $subname, $num_events; 
            printf $fh "   { 0x%02X, %d, 0x%02X, 0x%02X, 0x%02X, 0x%02X, \"%s\", \"%s\", 0x%02X, %d, \"%s\", \"%s\", %s },\n", 
              $event->{EvSel}, $event->{Internal}, $umask_val, 
              $umask_ext_upi_val, $fcmask_iio_val, $portmask_iio_val, $name, 
              $cat, $ctr_mask, $event->{MaxIncCyc}, 
              $depstr, $subdesc, $defn_ptr;
            $num_events++;
         }
      }
      else
      {
# print "Ready to go with $evname\n";
         my %depmasks = (); 
         my $depstr = &conv_filter_to_deps($event, $filterlist_ref, \%depmasks);

         if (length $depstr >= $MAX_DEPSLEN)
         {
            print STDERR "WARN: String of dependencies for $evname exceeds $MAX_DEPSLEN chars and has been chopped.  Increase MAX_DEPSLEN variable to fix.\n";
            $depstr = substr $depstr, 0, ($MAX_DEPSLEN-1);
         }


         printf $fh "#define %s_UC_%s_%s  %d\n", $CHIP, $box_char, $evname, $num_events; 
         printf $fh "   { 0x%02X, 0x%02X, %d, \"%s\", \"%s\", 0x%02X, %d, \"%s\", \"%s\", %s },\n", 
           $event->{EvSel}, 0, $event->{Internal}, $evname, 
           $cat, $ctr_mask, $event->{MaxIncCyc}, 
           $depstr, $desc, $defn_ptr;
         $num_events++;
      }
   }

   printf $fh "\n}\n"; 
   printf $fh ("#define %s_%s_UC_EVENT_COUNT (sizeof(%s_%s_uc_events)/sizeof(%s_uc_event_entry_t))%s\n", $CHIP, $box_char, $CHIP, $box_char, $CHIP);

   return $num_events;
}




######################################################################
######################################################################
sub c_hdr
{
   my $h_fname = sprintf "%s_uc_pmon_events.h", $CHIP;
   return "\n#include $h_fname\n\n\n";
}


######################################################################
######################################################################
sub print_per_box_c
{
   my ($evlist_ref, $filterlist_ref) = @_;

   # Indent spaces for levels in hierarchy
   foreach my $boxevents (sort keys %{ $evlist_ref })
   {
      my $box = $boxevents; $box =~ s/\s+Box Events\s*//; 
      my $fname = sprintf "%s_%s_uc_pmon_events.c", $CHIP, $box;
      open(BOXC, "> $fname") || 
         die "Couldn't open $fname for Writing\n";

      print BOXC &c_hdr();
      printf BOXC ("// Event Definitions for %s\n", $box);
      my $num_events = &create_defn_strs($evlist_ref, $box, $boxevents, \*BOXC);
      printf BOXC ("// end of Event Definitions for %s%s", $box, "\n" x 5);

      printf BOXC ("// Events for %s\n", $box);
      my $num_events = &create_c_recs($evlist_ref, $filterlist_ref, $box, $boxevents, \*BOXC);
      printf BOXC ("// end of Events for %s%s", $box, "\n" x 8);

      close(BOXC);
   }
}



######################################################################
######################################################################
sub print_merged_c
{
   my ($evlist_ref, $filterlist_ref) = @_;

   my $fname = sprintf "%s_uc_pmon_events.c", $CHIP;
   open(CHIPC, "> $fname") || die "Couldn't open $fname for Writing\n";
   print CHIPC &c_hdr();

   # Indent spaces for levels in hierarchy
   foreach my $boxevents (sort keys %{ $evlist_ref })
   {
      my $box = $boxevents; $box =~ s/\s+Box Events\s*//; 
      printf CHIPC ("// Event Definitions for %s\n", $box);
      my $num_events = &create_defn_strs($evlist_ref, $box, $boxevents, \*CHIPC);
      printf CHIPC ("// end of Events Definitions for %s%s", $box, "\n" x 5);

      printf CHIPC ("// Events for %s\n", $box);
      my $num_events = &create_c_recs($evlist_ref, $filterlist_ref, $box, $boxevents, \*CHIPC);
      printf CHIPC ("// end of Events for %s%s", $box, "\n" x 8);
   }
   close(CHIPC);
}



#######################################################################
#######################################################################
sub help
{
print <<EOH;
Input flags to script:
   -h - Help - This
   -v - For easily switching versions of PerlDB Files 
        Changes 'v0.x' in path string to PerlDB Files 
   -c - Chip to generate doc for 
        Currently recognizes 'skx'
EOH
}


#######################################################################
# Command Line Arguments:
#  -h - Help - This
#  -v - For easily switching versions of PerlDB Files 
#       Changes 'v0.x' in path string to PerlDB Files 
#  -c - Chip to generate doc for 
#       Currently recognizes 'skx'
#######################################################################
sub main
{
   my ($gen_box_files) = (0);
   my $chip    = "skx";  
   my $version = "0.10";

   while (my $arg = shift @ARGV)
   {
      if ($arg eq "-h") { &help; exit; }
      $gen_box_files  = 1 if ($arg eq "-b");
      if ($arg eq "-c") 
      { 
         $chip   = shift @ARGV; 
         $CHIP   = uc($chip);
	 $PerlDBEvents  =~ s/skx/$chip/g;
	 $PerlDBDerived =~ s/skx/$chip/g;
      }
      if ($arg eq "-v")
      {
         $version = shift @ARGV;
	 $PerlDBEvents  =~ s/v0\.10/v$version/g;
	 $PerlDBDerived =~ s/v0\.10/v$version/g;
      } 
   }

print STDERR "Ready to read from $PerlDBEvents for CHIP $CHIP\n";

   require $PerlDBEvents || die "Couldn't find $PerlDBEvents";

   my $evlist_ref = (); my $derlist_ref = (); my $filterlist_ref = ();
   $evlist_ref   = \%SKX_UCEventList   if ($CHIP eq "SKX");

   $filterlist_ref   = \%SKX_UCFilterAliases   if ($CHIP eq "SKX");

   if ($gen_derived)
   {
      require $PerlDBDerived || die "Couldn't find $PerlDBDerived";
      $derlist_ref = \%SKX_UCDerivedList if ($CHIP eq "SKX");
   }


   # print the shared .h file 
   &print_shared_h($evlist_ref);

   # print the shared .c file(s)
   ($gen_box_files) ? 
      &print_per_box_c($evlist_ref, $filterlist_ref):
      &print_merged_c($evlist_ref, $filterlist_ref);

}


